home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
wecjvb10
/
wecj.bas
< prev
next >
Wrap
BASIC Source File
|
1995-10-23
|
4KB
|
136 lines
Declare Function ECJ_Decode% Lib "WECJLIB.DLL" (ByVal Filen$, ByVal attrib%, ByVal ECJMessage&, ByVal ECJCallback&)
Declare Function MakeDIBPalette% Lib "WECJDIB.DLL" (ByVal lpBmi&)
Declare Function DibXY& Lib "WECJDIB.DLL" (ByVal lpBmi&, ByVal X%, ByVal Y%)
Declare Function DibXSize% Lib "WECJDIB.DLL" (ByVal lpBmi&)
Declare Function DibYSize% Lib "WECJDIB.DLL" (ByVal lpBmi&)
Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
Declare Function SetDIBitsToDevice% Lib "GDI" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal dX%, ByVal dY%, ByVal SrcX%, ByVal SrcY%, ByVal Scan%, ByVal NumScans%, ByVal Bits&, ByVal BitsInfo&, ByVal wUsage%)
Declare Function StretchDIBits% Lib "GDI" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal dX%, ByVal dY%, ByVal SrcX%, ByVal SrcY%, ByVal wSrcWidth%, ByVal wSrcHeight%, ByVal lpbits&, ByVal lpBitsInfo&, ByVal wUsage%, ByVal dwRop&)
Declare Function SetStretchBltMode% Lib "GDI" (ByVal hDC%, ByVal nStretchMode%)
Declare Function SelectPalette% Lib "User" (ByVal hDC%, ByVal hPalette%, ByVal bForceBackground%)
Declare Function RealizePalette% Lib "User" (ByVal hDC%)
Declare Function GetSystemMetrics% Lib "User" (ByVal nIndex%)
Declare Function GlobalLock& Lib "Kernel" (ByVal hMem%)
Declare Function GlobalUnlock% Lib "Kernel" (ByVal hMem%)
Global Const SM_CYCAPTION = 4
Global Const SM_CYMENU = 15
Global Const SM_CXFRAME = 32
Global Const SM_CYFRAME = 33
Global Const SRCCOPY = &HCC0020
Global Const STRETCH_DELETESCANS = 3
Global Const OFN_HIDEREADONLY = &H4&
Global Const ECJ_HALF_SIZE = 1
Global Const ECJ_AUTO_SIZE = 2
Global Const ECJ_GRAY_ONLY = 4
Global Const ECJ_2_PASS = 8
Global Const ECJ_DITHER = 16
Global Const ECJ_24_BITS = 32
Global Const ECJ_4_SIZE = 64
Global Const ECJ_8_SIZE = 128
Global attributes As Integer
Global hDib As Integer
Global hPalette As Integer
Global holdpal As Integer
Global filename As String * 80
Global maxX As Integer
Global maxY As Integer
Global ExtraX As Integer
Global ExtraY As Integer
Function Paint_DIB (ByVal hDC%, ByVal hDib%)
Dim lpbmih As Long
Dim wx As Integer
Dim wy As Integer
Dim lpbits As Long
If (hDib > 0) Then
lpbmih = GlobalLock(hDib)
If (hPalette > 0) Then
dum% = SelectPalette(hDC, holdpal, False)
dum% = DeleteObject(hPalette)
End If
hPalette = MakeDIBPalette(lpbmih)
holdpal = SelectPalette(hDC, hPalette, False)
dum% = RealizePalette(hDC)
wx = DibXSize(lpbmih)
wy = DibYSize(lpbmih)
lpbits = DibXY(lpbmih, 0, 0)
dum% = SetDIBitsToDevice(hDC, 0, 0, wx, wy, 0, 0, 0, wy, lpbits, lpbmih, DIB_RGB_COLORS)
dum% = GlobalUnlock(hDib)
End If
End Function
Function Paint_DIBStretch (ByVal hDC%, ByVal hDib%)
Dim lpbmih As Long
Dim wx As Integer
Dim wy As Integer
Dim dwx As Integer
Dim dwy As Integer
Dim lpbits As Long
If (hDib > 0) Then
lpbmih = GlobalLock(hDib)
If (hPalette > 0) Then
dum% = SelectPalette(hDC, holdpal, False)
dum% = DeleteObject(hPalette)
End If
hPalette = MakeDIBPalette(lpbmih)
holdpal = SelectPalette(hDC, hPalette, False)
dum% = RealizePalette(hDC)
wx = DibXSize(lpbmih)
wy = DibYSize(lpbmih)
dwx = Int(Form1.ScaleWidth)
dwy = Int(Form1.ScaleHeight)
lpbits = DibXY(lpbmih, 0, 0)
dum% = StretchDIBits(hDC, 0, 0, dwx, dwy, 0, 0, wx, wy, lpbits, lpbmih, DIB_RGB_COLORS, SRCCOPY)
dum% = GlobalUnlock(hDib)
End If
End Function
Sub ScaleForm (ByVal hDib%)
Dim nYsize As Integer
Dim nXsize As Integer
Dim wx As Integer
Dim wy As Integer
Dim rx As Single
Dim ry As Single
If (hDib > 0) Then
lpbmih = GlobalLock(hDib)
wx = DibXSize(lpbmih)
wy = DibYSize(lpbmih)
If ((wx > maxX) Or (wy > maxY)) Then
ry = wy / maxY
rx = wx / maxX
If (ry > rx) Then
nYsize = Int(wy / ry)
nXsize = Int(wx / ry)
Form1.Height = Screen.TwipsPerPixelY * (nYsize + ExtraX)
Form1.Width = Screen.TwipsPerPixelX * (nXsize + ExtraY)
Else
nYsize = Int(wy / rx)
nXsize = Int(wx / rx)
Form1.Height = Screen.TwipsPerPixelY * (nYsize + ExtraX)
Form1.Width = Screen.TwipsPerPixelX * (nXsize + ExtraY)
End If
Else
Form1.Height = Screen.TwipsPerPixelY * (wy + ExtraY)
Form1.Width = Screen.TwipsPerPixelX * (wx + ExtraX)
End If
End If
End Sub